structure OptonASM = 
struct 
  structure A = Assem

  (* two data structures *)
  (* 1. to-be-deleted asm No
     2. list of type (reg, (reg, int), int list) to hold the common-subexp *)

(*  val to_del : int list ref = ref []

  val com_sexp : (A.reg * (A.reg * int) * (int list)) list ref = ref []*)

  fun unionlists l1 l2 = 
      let fun fd (i1,(i2::r)) = if i1 = i2
			      then r
			      else i2::(fd(i1, r))
	    | fd (i1,[]) = []
	  val l2' = List.foldl fd l2 l1
      in l1@l2'
      end

  fun sublists l1 l2 = 
      let fun fd (i2::r) (i1, clist) = if i1 = i2
				       then clist
				       else fd r (i1, clist)
	    | fd [] (i1, clist) = i1::clist
      in List.foldl (fd l2) [] l1
      end

  (* remove the node of common_subexp about reg1 *)
  fun rm_reg reg1 c_sexps = 
      let fun fdfun ((r1, o1, o2), clist) = if reg1 = r1 
					    then clist
					    else (r1, o1, o2)::clist
      in List.foldr fdfun [] c_sexps
      end

  (* exist the node of common_subexp about reg1 *)
  fun ex_reg reg1 c_sexps = 
      let fun fdfun ((r1, o1, o2), com_exp) = if reg1 = r1 
					      then SOME(o1, o2)
					      else com_exp
      in List.foldr fdfun NONE c_sexps
      end
  
  (* update common_sexp *)
  fun up_sexp (reg, i_con) i_con1 oper = 
      let fun mth 0 = (reg, i_con)          (* mov *)
	    | mth 1 = (reg, i_con + i_con1) (* add *)
	    | mth 2 = (reg, i_con - i_con1) (* sub *)
	    | mth _ = (reg, i_con)
      in mth oper
      end

  (* add each asm with label *)
  fun add_no  asmlist = 
      let fun fdfun (p, (i, plist)) = (i+1, (i, p) :: plist)
      in List.rev(#2(List.foldl fdfun (1, []) asmlist))
      end 

  (* foreach instr *)
  fun for_instr (inst, (pre_insts, c_sexps, tdels)) = 
      let fun mtch (t_inst as (lb, A.Addr(r1, r2))) = 
	      (t_inst::pre_insts, (rm_reg r2 c_sexps), tdels)
	    | mtch (t_inst as (lb, A.Addz(i1, r1))) = 
	      let val inf = ex_reg r1 c_sexps
	      in (fn NONE => (t_inst::pre_insts, c_sexps, tdels)
		   | (SOME(o1, o2)) => (let val n_node = (r1, (up_sexp o1 i1 1), lb::o2)
					    val n_sexps = n_node::(rm_reg r1 c_sexps)
					in (t_inst::pre_insts, n_sexps, tdels)
					end)) inf
	      end
	    | mtch (t_inst as (lb, A.Subr(r1, r2))) = 
	      (t_inst::pre_insts, (rm_reg r2 c_sexps), tdels)
	    | mtch (t_inst as (lb, A.Subz(i1, r1))) = 
	      let val inf = ex_reg r1 c_sexps
	      in (fn NONE => (t_inst::pre_insts, c_sexps, tdels)
		   | (SOME(o1, o2)) => (let val n_node = (r1, (up_sexp o1 i1 2), lb::o2)
					    val n_sexps = n_node::(rm_reg r1 c_sexps)
					in (t_inst::pre_insts, n_sexps, tdels)
					end)) inf
	      end
	    | mtch (t_inst as (lb, A.Mulr(r1, r2))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val inf2 = ex_reg r2 c_sexps
		  val n_tdels = (fn (NONE, NONE) => []
				  | (SOME(o1,o2), SOME(o3, o4)) => unionlists o2 o4
				  | (SOME(o1,o2), NONE) => o2
				  | (NONE, SOME(o1,o2)) => o2) (inf1, inf2)
	      in (t_inst::pre_insts, (rm_reg A.Edx (rm_reg A.Eax c_sexps)), (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Mulz(i1, r1))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val n_tdels = (fn NONE => []
				  | (SOME(o1,o2)) => o2) inf1
	      in (t_inst::pre_insts, (rm_reg A.Edx (rm_reg A.Eax c_sexps)), (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Div(r1))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val n_tdels = (fn NONE => []
				  | (SOME(o1,o2)) => o2) inf1
	      in (t_inst::pre_insts, (rm_reg A.Eax c_sexps), (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Push(r1))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val n_tdels = (fn NONE => []
				  | (SOME(o1,o2)) => o2) inf1
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Pop(r1))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val n_tdels = (fn NONE => []
				  | (SOME(o1,o2)) => o2) inf1
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Beq(r1, r2, tlab))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val inf2 = ex_reg r2 c_sexps
		  val n_tdels = (fn (NONE, NONE) => []
				  | (SOME(o1,o2), SOME(o3, o4)) => unionlists o2 o4
				  | (SOME(o1,o2), NONE) => o2
				  | (NONE, SOME(o1,o2)) => o2) (inf1, inf2)
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Bgt(r1, r2, tlab))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val inf2 = ex_reg r2 c_sexps
		  val n_tdels = (fn (NONE, NONE) => []
				  | (SOME(o1,o2), SOME(o3, o4)) => unionlists o2 o4
				  | (SOME(o1,o2), NONE) => o2
				  | (NONE, SOME(o1,o2)) => o2) (inf1, inf2)
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Bge((r1, r2, tlab)))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val inf2 = ex_reg r2 c_sexps
		  val n_tdels = (fn (NONE, NONE) => []
				  | (SOME(o1,o2), SOME(o3, o4)) => unionlists o2 o4
				  | (SOME(o1,o2), NONE) => o2
				  | (NONE, SOME(o1,o2)) => o2) (inf1, inf2)
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Beqi(i1, r1, tlab))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val n_tdels = (fn NONE => []
				  | (SOME(o1,o2)) => o2) inf1
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Bgti(i1, r1, tlab))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val n_tdels = (fn NONE => []
				  | (SOME(o1,o2)) => o2) inf1
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Xchg(r1, r2))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val inf2 = ex_reg r2 c_sexps
		  val n_sexps' = (fn (NONE, NONE) => []
				  | (SOME(o1,o2), SOME(o3, o4)) =>
				    (r1, o3, o4)::[(r2, o1, o2)]
				  | (SOME(o1,o2), NONE) => 
				    [(r2, o1, o2)]
				  | (NONE, SOME(o1,o2)) => 
				    [(r1, o1, o2)]) (inf1, inf2)
		  val n_sexps = n_sexps'@(rm_reg r1 (rm_reg r2 c_sexps))
	      in (t_inst::pre_insts, n_sexps, tdels) (* may be wrong *)
	      end
	    | mtch (t_inst as (lb, A.Leal(tlab, r1))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val n_tdels = (fn NONE => []
				  | (SOME(o1,o2)) => o2) inf1
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Leab(i1, r1, r2))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val inf2 = ex_reg r2 c_sexps
		  val n_tdels = (fn (NONE, NONE) => []
				  | (SOME(o1,o2), SOME(o3, o4)) => unionlists o2 o4
				  | (SOME(o1,o2), NONE) => o2
				  | (NONE, SOME(o1,o2)) => o2) (inf1, inf2)
	      in (t_inst::pre_insts, c_sexps, (sublists tdels n_tdels))
	      end
	    | mtch (t_inst as (lb, A.Movr(r1, r2))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val result = (fn NONE => (t_inst::pre_insts, (rm_reg r2 c_sexps), tdels)
				 | (SOME(o1, o2)) => (t_inst::pre_insts, (r2, o1, lb::o2)::(rm_reg r2 c_sexps), tdels)
			       ) inf1
		  val n_sexp = (r2, (A.Ebp, 0), [lb])
	      in if r1 = A.Ebp
		 then (t_inst::pre_insts, n_sexp::(rm_reg r2 c_sexps), tdels)
		 else result
	      end
	    | mtch (t_inst as (lb, A.Movz(i1, r1))) = 
	      (t_inst::pre_insts, (rm_reg r1 c_sexps), tdels)
	    | mtch (t_inst as (lb, A.Movld(i1, r1, r2))) = 
	      let val inf1 = ex_reg r1 c_sexps
		  val n_instr = (fn NONE => (A.Movld(i1, r1, r2), [])
				  | (SOME((rg', off), o2)) => (A.Movld(off+i1, rg', r2), o2)
				) inf1
	      in ((lb, #1 n_instr)::pre_insts, (rm_reg r2 c_sexps), ((#2 n_instr)@ tdels))
	      end
	    | mtch (t_inst as (lb, A.Movst(r1, i1, r2))) = 
	      let val inf1 = ex_reg r2 c_sexps
		  val n_instr = (fn NONE => (A.Movst(r1, i1, r2), [])
				  | (SOME((rg', off), o2)) => (A.Movst(r1, i1+off, rg'), o2)
				) inf1
	      in ((lb,#1 n_instr)::pre_insts, c_sexps, ((#2 n_instr)@tdels))
	      end
	    | mtch t_inst = (t_inst::pre_insts, c_sexps, tdels)
      in mtch inst
      end
  
  (* foreach block *)
  fun for_block bk = 
      let val bk' = add_no bk
	  val (n_bk, dummy, tdels) = List.foldl for_instr ([],[],[]) bk'
	  fun ex (i1::r) i2 = if i1 = i2
			      then true 
			      else ex r i2
	    | ex [] i2 = false
	  fun del_instr ((lb, instr), ilist) = if ex tdels lb
					       then ilist
					       else (lb, instr)::ilist
	  val n_bk' = List.foldl del_instr [] n_bk
      in List.rev(List.map (fn (lb, t) => t) n_bk')
      end
  
  (* top *)
  fun asm2bks (A.Jmp(lb)::asmlist) c_bk bklist = asm2bks asmlist [A.Jmp(lb)] (c_bk::bklist)
    | asm2bks (instr::asmlist) c_bk bklist = asm2bks asmlist (instr::c_bk) bklist
    | asm2bks [] c_bk bklist = c_bk::bklist
  
  fun reorg_asm asmlist = 
      let val bks = List.rev(asm2bks asmlist [] [])
      in List.concat(List.map for_block bks)
      end
  
end
